{
  glSOAR

  ObjectPascal implementation of SOAR terrain rendering algorithm using OpenGL
  by Marek Mauder (pentar@seznam.cz)

  The contents of this file are used with permission, subject to the Mozilla
  Public License Version 1.1 (the "License"); you may not use this file except
  in compliance with the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL/MPL-1.1.html

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  the specific language governing rights and limitations under the License.

  Alternatively, the contents of this file may be used under the terms of the
  GNU Lesser General Public License (the  "LGPL License"), in which case the
  provisions of the LGPL License are applicable instead of those above.
  If you wish to allow use of your version of this file only under the terms
  of the LGPL License and not to allow others to use your version of this file
  under the MPL, indicate your decision by deleting  the provisions above and
  replace  them with the notice and other provisions required by the LGPL
  License.  If you do not delete the provisions above, a recipient may use
  your version of this file under either the MPL or the LGPL License.

  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
}

unit glSOARHelpers;

interface

uses
{$IF defined(MSWINDOWS)}
  Windows,
{$ELSEIF defined(LINUX)  or defined(UNIX)}
  {$IFDEF FPC}
    BaseUnix, Unix,
  {$ELSE}
    Libc,
  {$ENDIF}
{$IFEND}
  SysUtils,
  Gl,
  Glext,
  Glu,
  Glut,
  Keyboards,
  glSOARMain,
  VUMaths,
  ImagingTypes,
  ImagingClasses,
  ImagingUtility,
  ImagingOpenGL;

const
{$IF defined(MSWINDOWS)}
  KEY_UP = VK_UP;
  KEY_DOWN = VK_DOWN;
  KEY_LEFT = VK_LEFT;
  KEY_RIGHT = VK_RIGHT;
  KEY_SHIFT = VK_SHIFT;
  KEY_CONTROL = VK_CONTROL;
  KEY_PAGEUP = VK_PRIOR;
  KEY_PAGEDOWN = VK_NEXT;
{$ELSEIF defined(LINUX) or defined(UNIX)}
  KEY_UP = 0;
  KEY_DOWN = 0;
  KEY_LEFT = 0;
  KEY_RIGHT = 0;
  KEY_SHIFT = 0;
  KEY_CONTROL = 0;
  KEY_PAGEUP = 0;
  KEY_PAGEDOWN = 0;
{$ELSE}
  {$MESSAGE FATAL 'Not implemented.'}
{$IFEND}

type
  TKeyFrame = record
    Position: TVector3;
    Direction: TVector3;
    Time: Single;
    FPS: Single;
    TPF: Single;
  end;

  TAnimation = record
    Speed: Single;
    FrameCount: LongInt;
    CurrentFrame: LongInt;
    Length: Single;
    Frames: array of TKeyFrame;
  end;

procedure MsgOut(const Msg: string);
procedure BeginText;
procedure EndText;
procedure TextOut(X, Y: LongInt; const Text: string; Color: TColor32 = $FFFFFFFF);
procedure EnableTextures;
procedure DisableTextures;
procedure ReturnMouse;
procedure UpdateFrustum(var Frustum: TFrustum);
procedure LoadAnimation(var Anim: TAnimation; const FileName: string; TerrainSize: LongInt);
function AnimateCamera(var Anim: TAnimation; const Time: Single;
  var Position, Direction: TVector3): Boolean;
function LoadTexture(const FileName: string): GLuint;

var
  OldMouseX, OldMouseY: LongInt;
  MouseX, MouseY: LongInt;
  Anisotropy: Boolean = False;
  DXTCompression: Boolean = False;
  MultiTexturing: Boolean = False;

implementation

var
  ViewPort: array[0..3] of LongInt;

procedure MsgOut(const Msg: string);
begin
  if IsConsole then
    WriteLn(Msg);
end;

procedure BeginText;
begin
  glMatrixMode(GL_PROJECTION);
  glPushMatrix();
  glLoadIdentity();
  glGetIntegerv(GL_VIEWPORT, @ViewPort);
  glOrtho(0, ViewPort[2], ViewPort[3], 0, -1, 1);
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix();
  glLoadIdentity();
  DisableTextures;
end;

procedure EndText;
begin
  EnableTextures;
  glMatrixMode(GL_PROJECTION);
  glPopMatrix();
  glMatrixMode(GL_MODELVIEW);
  glPopMatrix();
end;

procedure TextOut(X, Y: LongInt; const Text: string; Color: TColor32);
(*
{$IFDEF MSWINDOWS}
var
  I: LongInt;
  C: TColor32Rec;
{$ENDIF}
*)
begin
//{$IFDEF MSWINDOWS}
{  C.Color := Color;
  glColor4ub(C.R, C.G, C.B, C.A);
  glRasterPos2f(X, 15 + Y);
  for I := 1 to Length(Text) do
    glutBitmapCharacter(GLUT_BITMAP_9_BY_15, Ord(Text[I]));}
//{$ENDIF}
end;

procedure EnableTextures;
begin
  if MultiTexturing then
  begin
    glActiveTextureARB(GL_TEXTURE1_ARB);
    glEnable(GL_TEXTURE_2D);
    glActiveTextureARB(GL_TEXTURE0_ARB);
  end;
  glEnable(GL_TEXTURE_2D);
  glColor4f(1.0, 1.0, 1.0, 1.0);
end;

procedure DisableTextures;
begin
  if MultiTexturing then
  begin
    glActiveTextureARB(GL_TEXTURE1_ARB);
    glDisable(GL_TEXTURE_2D);
    glActiveTextureARB(GL_TEXTURE0_ARB);
  end;
  glDisable(GL_TEXTURE_2D);
  glColor4f(1.0, 1.0, 1.0, 1.0);
end;

procedure ReturnMouse;
begin
  glGetIntegerv(GL_VIEWPORT, @ViewPort);
  OldMouseX := ViewPort[2] div 2;
  OldMouseY := ViewPort[3] div 2;
  glutWarpPointer(OldMouseX, OldMouseY);
  glutSetCursor(GLUT_CURSOR_NONE);
end;

procedure UpdateFrustum(var Frustum: TFrustum);
var
  View, Proj, Clip: TMatrix4;
begin
  glGetFloatv(GL_PROJECTION_MATRIX, @Proj);
  glGetFloatv(GL_MODELVIEW_MATRIX, @View);
  Clip := Mat4Multiply(View, Proj);
  // RIGHT plane
  Frustum[0].A := Clip.Item14 - Clip.Item11;
  Frustum[0].B := Clip.Item24 - Clip.Item21;
  Frustum[0].C := Clip.Item34 - Clip.Item31;
  Frustum[0].D := Clip.Item44 - Clip.Item41;
  PlaneNormalizeProc(Frustum[0]);
  // LEFT plane
  Frustum[1].A := Clip.Item14 + Clip.Item11;
  Frustum[1].B := Clip.Item24 + Clip.Item21;
  Frustum[1].C := Clip.Item34 + Clip.Item31;
  Frustum[1].D := Clip.Item44 + Clip.Item41;
  PlaneNormalizeProc(Frustum[1]);
  // BOTTOM plane
  Frustum[2].A := Clip.Item14 + Clip.Item12;
  Frustum[2].B := Clip.Item24 + Clip.Item22;
  Frustum[2].C := Clip.Item34 + Clip.Item32;
  Frustum[2].D := Clip.Item44 + Clip.Item42;
  PlaneNormalizeProc(Frustum[2]);
  // TOP plane
  Frustum[3].A := Clip.Item14 - Clip.Item12;
  Frustum[3].B := Clip.Item24 - Clip.Item22;
  Frustum[3].C := Clip.Item34 - Clip.Item32;
  Frustum[3].D := Clip.Item44 - Clip.Item42;
  PlaneNormalizeProc(Frustum[3]);
  // FAR plane
  Frustum[4].A := Clip.Item14 - Clip.Item13;
  Frustum[4].B := Clip.Item24 - Clip.Item23;
  Frustum[4].C := Clip.Item34 - Clip.Item33;
  Frustum[4].D := Clip.Item44 - Clip.Item43;
  PlaneNormalizeProc(Frustum[4]);
  // NEAR plane
  Frustum[5].A := Clip.Item14 + Clip.Item13;
  Frustum[5].B := Clip.Item24 + Clip.Item23;
  Frustum[5].C := Clip.Item34 + Clip.Item33;
  Frustum[5].D := Clip.Item44 + Clip.Item43;
  PlaneNormalizeProc(Frustum[5]);
end;

procedure LoadAnimation(var Anim: TAnimation; const FileName: string; TerrainSize: LongInt);
var
  I: LongInt;
  Dist: Single;
  FileAnim: TextFile;
begin
  writeln('LoadAnimation("',FileName,'") fileexists=("'+FileName+'")',FileExists(FileName));
  AssignFile(FileAnim, FileName);
  Reset(FileAnim);

  ReadLn(FileAnim, Anim.Speed);
  Anim.Speed := Anim.Speed * TerrainSize / 1024;
  ReadLn(FileAnim, Anim.FrameCount);

  SetLength(Anim.Frames, Anim.FrameCount);

  for I := 0 to Anim.FrameCount - 1 do
  begin
    ReadLn(FileAnim, Anim.Frames[I].Position.X, Anim.Frames[I].Position.Y,
      Anim.Frames[I].Position.Z);
    ReadLn(FileAnim, Anim.Frames[I].Direction.X, Anim.Frames[I].Direction.Y,
      Anim.Frames[I].Direction.Z);
    Anim.Frames[I].Position := Vec3Scale(Anim.Frames[I].Position, TerrainSize);  
    Anim.Frames[I].Direction := Vec3Normalize(Anim.Frames[I].Direction);
  end;

  CloseFile(FileAnim);

  // Calc frame times
  Anim.Frames[0].Time := 0.0;
  Dist := 0.0;

  for I := 1 to Anim.FrameCount - 1 do
  begin
    Dist := Dist + Vec3Dist(Anim.Frames[I].Position, Anim.Frames[I - 1].Position);
    Anim.Frames[I].Time := Dist / Anim.Speed;
  end;

  Anim.CurrentFrame := -1;
  Anim.Length := Anim.Frames[Anim.FrameCount - 1].Time;
end;

function AnimateCamera(var Anim: TAnimation; const Time: Single;
  var Position, Direction: TVector3): Boolean;
var
  I: LongInt;
  Delta, LerpTime: Single;
begin
  Result := False;

  if Anim.FrameCount > 0 then
  begin
    if Time >= Anim.Length then
    begin
      Anim.CurrentFrame := Anim.FrameCount - 1;
      Result := True;
      Exit;
    end;

    for I := 0 to Anim.FrameCount - 1 do
    begin
      if Time > Anim.Frames[I].Time then
      begin
        Delta := Anim.Frames[I + 1].Time - Anim.Frames[I].Time;
        LerpTime := 1.0 - (Anim.Frames[I + 1].Time - Time) / Delta;
        Position := Vec3Lerp(Anim.Frames[I].Position, Anim.Frames[I + 1].Position, LerpTime);
        Direction := Vec3Lerp(Anim.Frames[I].Direction, Anim.Frames[I + 1].Direction, LerpTime);

        if I > Anim.CurrentFrame then
        begin
          Anim.CurrentFrame := I;
          Result := True;
        end;
      end;
    end;
  end;
end;

function LoadTexture(const FileName: string): GLuint;
var
  Img: TMultiImage;
  Caps: TGLTextureCaps;
begin
  GetGLTextureCaps(Caps);
  Img := TMultiImage.CreateFromFile(FileName);

  if Img.Valid then
  begin
    {if DXTCompression and Caps.DXTCompression then
    begin
      if Img.FormatInfo.HasAlphaChannel then
        Img.ConvertLevels(ifDXT5)
      else
        Img.ConvertLevels(ifDXT1);
    end
    else
      if Img.FormatInfo.IsSpecial then
        Img.ConvertLevels(ifDefault);}

    Result := CreateGLTextureFromMultiImage(Img.DataArray);

    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

    if Anisotropy and (Caps.MaxAnisotropy > 0) then
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAX_ANISOTROPY_EXT, Caps.MaxAnisotropy);

    MsgOut(Format('Texture loaded:   %-16s (format: %s)', [ExtractFileName(FileName), string(Img.FormatInfo.Name)]));
  end
  else
  begin
    Result := 0;
    MsgOut(Format('Error loading texture: %s', [ExtractFileName(FileName)]));
  end;

  Img.Free;
end;


end.
